home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / RAMSES 2.2 / RAMSES 2.2 Extras / RMSBaseExtra / RMSDebugHelp.MOD < prev    next >
Encoding:
Modula Implementation  |  1996-06-21  |  5.8 KB  |  223 lines  |  [TEXT/ALFA]
  1. IMPLEMENTATION MODULE RMSDebugHelp;
  2.  
  3.   (*
  4.         Implementation and Revisions:
  5.         ============================
  6.  
  7.         Author  Date        Description
  8.         ------  ----        -----------
  9.  
  10.         AF      21/10/90    First implementation (DM 2.01, MacMETH 2.6+)
  11.  
  12.         or        23/05/91    uses now DMOpSys and DMMessages instead of DMSubLaunch
  13.         af        11/05/93    ActivateHeapTrace added (new key)
  14.   *)
  15.  
  16.   FROM SYSTEM IMPORT ADDRESS, VAL;
  17.   FROM DMMessages IMPORT Inform, Warn;
  18.   FROM DMConversions IMPORT IntToString, LongIntToString;
  19.   FROM DMSystem IMPORT startUpLevel, maxLevel, CurrentDMLevel, 
  20.     InstallTermProc, InstallInitProc;
  21.   FROM DMStrings IMPORT Append, AppendCh;
  22.   FROM DMHeapWatch IMPORT showLevels, blockSizes, allocInfoProc, debugProc;
  23.  
  24. (*. (* needed for implementation of ActivateHeapTrace *)
  25.   FROM SYSTEM IMPORT ADDRESS, VAL;
  26.   FROM DMFiles IMPORT TextFile, 
  27.     WriteChars, WriteChar, WriteEOL, Close;
  28. .*)
  29.   
  30.   VAR
  31.     installed: BOOLEAN;  
  32.     alreadyHalted: ARRAY [startUpLevel..maxLevel] OF BOOLEAN;
  33.  
  34.   VAR
  35.    startLev: CARDINAL;
  36.     
  37.     
  38.     
  39.   PROCEDURE ShowLevels (procName: ARRAY OF CHAR; anInt: INTEGER; size: LONGINT);
  40.     VAR str1, str2: ARRAY [0..63] OF CHAR; istr: ARRAY [0..23] OF CHAR;
  41.   BEGIN
  42.     str1 := 'In ';
  43.     Append(str1,procName);
  44.     AppendCh(str1,':');
  45.     
  46.     str2 := 'anInt='; 
  47.     IntToString(anInt,istr,0);
  48.     Append(str2,istr);
  49.     
  50.     str2 := 'size='; 
  51.     LongIntToString(size,istr,0);
  52.     Append(str2,istr);
  53.     
  54.     Append(str2,'  CurrentDMLevel()=');
  55.     IntToString(CurrentDMLevel(),istr,0);
  56.     Append(str2,istr);
  57.     
  58.     Inform( str1, str2, "" );
  59.     
  60.     IF NOT alreadyHalted[CurrentDMLevel()] THEN 
  61.       alreadyHalted[CurrentDMLevel()]:= TRUE; Warn(str1,str2,"");
  62.     END;
  63.   END ShowLevels;
  64.   
  65.   PROCEDURE ShowCaller (procName: ARRAY OF CHAR; level: INTEGER; 
  66.                         size: LONGINT);
  67.     VAR str1, str2: ARRAY [0..63] OF CHAR; istr: ARRAY [0..23] OF CHAR;
  68.   BEGIN
  69.     str1 := 'In ';
  70.     Append(str1,procName);
  71.     AppendCh(str1,':');
  72.     
  73.     str2 := 'level='; 
  74.     IntToString(level,istr,0);
  75.     Append(str2,istr);
  76.     
  77.     str2 := 'size='; 
  78.     LongIntToString(size,istr,0);
  79.     Append(str2,istr);
  80.     
  81.     Append(str2,'  CurrentDMLevel()=');
  82.     IntToString(CurrentDMLevel(),istr,0);
  83.     Append(str2,istr);
  84.         
  85.     Inform( str1, str2, "" );
  86.     
  87.     (*. IF NOT alreadyHalted[CurrentDMLevel()] THEN 
  88.       alreadyHalted[CurrentDMLevel()]:= TRUE; HALT;
  89.     END; .*)
  90.     Warn(str1,str2,"");
  91.   END ShowCaller;
  92.   
  93.    
  94.   CONST
  95.     TAB = 11C ;
  96.  
  97. (*.  (* needed for implementation of ActivateHeapTrace *)
  98.   VAR
  99.    outF: TextFile;
  100.     str: ARRAY [0..31] OF CHAR;
  101.  
  102.   PROCEDURE AllocInfoP( pBefore, pAfter: ADDRESS; size: LONGINT; lev: INTEGER);
  103.   BEGIN
  104.     WriteChar( outF, "A" );
  105.     WriteChar( outF, TAB );
  106.     (* old address *)
  107.     LongIntToString( VAL(LONGINT,pBefore), str, 1 ); 
  108.     WriteChars( outF, str );        
  109.     WriteChar( outF, TAB );
  110.     (* size *)
  111.     LongIntToString( size, str, 1 );
  112.     WriteChars( outF, str );         
  113.     WriteChar( outF, TAB );
  114.     (* level *)
  115.     IntToString( lev, str, 1 );
  116.     WriteChars( outF, str );         
  117.     WriteChar( outF, TAB );
  118.     (* new address *)
  119.     LongIntToString( VAL(LONGINT,pAfter), str, 1 ); 
  120.     WriteChars( outF, str );        
  121.     WriteEOL( outF );
  122.   END AllocInfoP;
  123.   
  124.   PROCEDURE DeallocInfoP(pBefore, pAfter: ADDRESS; level: INTEGER);
  125.   BEGIN
  126.     WriteChar( outF, "D" );
  127.     WriteChar( outF, TAB );
  128.     (* the address AFTER dealloc *)
  129.     LongIntToString( VAL(LONGINT,pAfter), str, 1 ); 
  130.     WriteChars( outF, str );        
  131.     WriteChar( outF, TAB );
  132.     (* size *)
  133.     WriteChar( outF, TAB );
  134.     (* level *)
  135.     IntToString( level, str, 1 );
  136.     WriteChars( outF, str );         
  137.     WriteChar( outF, TAB );
  138.     (* the address BEFORE dealloc *)
  139.     LongIntToString( VAL(LONGINT,pBefore), str, 1 ); 
  140.     WriteChars( outF, str );        
  141.     WriteEOL( outF );
  142.   END DeallocInfoP;
  143.   
  144.   PROCEDURE CloseOutF;
  145.   BEGIN
  146.     Close( outF )
  147.   END CloseOutF;
  148.   
  149. .*) 
  150.  
  151.   PROCEDURE CloseOutF;
  152.   BEGIN
  153.   END CloseOutF;
  154.   
  155.   PROCEDURE ActivateHeapTrace;
  156.   BEGIN
  157. (*.  (* needed for implementation of ActivateHeapTrace *)
  158.     Lookup( outF, "DMStorage - DEBUG OUT", TRUE );
  159.     WriteChars( outF, "Alloc / Dealloc" );
  160.     WriteChar( outF, TAB );
  161.     WriteChars( outF, "before A / after D" );
  162.     WriteChar( outF, TAB );
  163.     WriteChars( outF, "size / -- " );
  164.     WriteChar( outF, TAB );
  165.     WriteChars( outF, "level / level" );
  166.     WriteChar( outF, TAB );
  167.     WriteChars( outF, "after A / before D" );
  168.     WriteEOL( outF );
  169.     allocInfoProc:=AllocInfoP;
  170.     deallocInfoProc:=DeallocInfoP;
  171. .*)
  172.   END ActivateHeapTrace;
  173.   
  174.   (*.
  175.   PROCEDURE AllocateHalt( pBefore, pAfter: ADDRESS; size: LONGINT; lev: INTEGER);
  176.     VAR msg: ARRAY [0..255] OF CHAR; str: ARRAY [0..31] OF CHAR;
  177.   BEGIN
  178.     IF size<>1032D THEN
  179.       RETURN
  180.     END(*IF*);
  181.     msg := "A";
  182.     AppendCh( msg, TAB );
  183.     (* old address *)
  184.     LongIntToString( VAL(LONGINT,pBefore), str, 1 ); 
  185.     Append(msg, str );        
  186.     AppendCh(msg, TAB );
  187.     (* size *)
  188.     LongIntToString( size, str, 1 );
  189.     Append(msg, str );         
  190.     AppendCh(msg, TAB );
  191.     (* level *)
  192.     IntToString( lev, str, 1 );
  193.     Append(msg, str );         
  194.     AppendCh(msg, TAB );
  195.     (* new address *)
  196.     LongIntToString( VAL(LONGINT,pAfter), str, 1 ); 
  197.     Append(msg, str );        
  198.     
  199.     Warn(msg,"","");
  200.   END AllocateHalt;
  201.   .*)
  202.    
  203.   PROCEDURE AtInit;
  204.   BEGIN
  205.     alreadyHalted[CurrentDMLevel()] := FALSE;
  206.   END AtInit;
  207.   
  208.   PROCEDURE AtTerm;
  209.   BEGIN
  210.     IF CurrentDMLevel()=startLev THEN CloseOutF END;
  211.   END AtTerm;
  212.     
  213. BEGIN
  214.   alreadyHalted[CurrentDMLevel()]:= FALSE;
  215.   InstallInitProc (AtInit,installed);
  216.   InstallTermProc (AtTerm,installed);
  217.   showLevels := ShowLevels;
  218.   blockSizes[0] := 0D; (* shown at allocation if same size *)
  219.   blockSizes[1] := 0D; (* shown at allocation if same size *)
  220.   debugProc := ShowCaller;
  221.   startLev := CurrentDMLevel();
  222. END RMSDebugHelp.